home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok40.lha / Environment / MPCompile.Mod < prev    next >
Text File  |  1993-08-15  |  12KB  |  384 lines
  1. MODULE MPCompile;
  2.  
  3. (* ********************************************************************** *)
  4. (*    Compilieren mit der Maus für beliebige Programmierumgebungen      *)
  5. (*          MPCompile  V3.3  ---  © 1990 by M.Peuckert          *)
  6. (* ********************************************************************** *)
  7. (*---------------------------------------------------------------------------
  8.    :Program.    MPCompile
  9.    :Version.    3.3
  10.    :Contants.   Compiling, linking, debugging, etc.
  11.    :History.    V2.0, Markus Peuckert, Simple
  12.    :History.    V3.0, Markus Peuckert, slightly improved version, Mar-89
  13.    :History.    V3.3, Markus Peuckert, Mar-90
  14.    :Author.     Markus Peuckert
  15.    :Address.    Schützenstr. 50, D-3550 Marburg, West-Germany,
  16.    :Copyright.  ShareWare
  17.    :Language.   Modula-2
  18.    :Translator. M2Amiga V3.3d
  19. ---------------------------------------------------------------------------*)
  20.  
  21. FROM SYSTEM        IMPORT     ADR,ADDRESS;
  22. FROM Arts    IMPORT    Assert;
  23. FROM Exec    IMPORT     WaitPort, GetMsg, ReplyMsg;
  24. FROM Intuition    IMPORT    GadgetPtr, IntuiMessagePtr, IDCMPFlags, IDCMPFlagSet,
  25.             CloseWindow, WindowFlags, WindowFlagSet, ScreenFlags,
  26.             ScreenFlagSet,     ActivationFlags, ActivationFlagSet,
  27.             WindowPtr, SetWindowTitles, RefreshGadgets,
  28.             ActivateGadget, RemoveGList, AddGList, SizeWindow,
  29.             MoveWindow, WindowToFront, WindowToBack;
  30. FROM Graphics    IMPORT    SetRast;
  31. FROM Dos    IMPORT    Execute, Lock, UnLock, sharedLock, FileLockPtr;
  32. FROM FileSystem    IMPORT    File;
  33. FROM Strings    IMPORT     Occurs, Insert, Delete, Length, Copy, first, last;
  34. IMPORT Str;
  35. FROM DosSupport    IMPORT    OpenCon, CloseCon, CD, WriteS, WriteLn, SetPenColor;
  36. FROM IntuiSup    IMPORT    CreateWindow, IDCMPOn, IDCMPOff, ActivWindow;
  37. FROM MPGad    IMPORT    MaxChar, DrawText, BufStrTyp, MakeGad,
  38.             compgad, linkgad, debuggad,rungad, exgad, edgad,
  39.             popgad, loadgad, savegad, compilgad, linkergad, makegad,
  40.             loadergad, prggad, editgad, CompilBuf, LinkerBuf,
  41.             LoaderBuf, PrgBuf, EditBuf, CompGad, LoadGad, PrgGad;
  42. FROM MPWin    IMPORT    WinLEFT, WinTOP, WinHEIGHT, WinWIDTH, DWidth, DHeight,
  43.             winTitle, win, win2, ConPtr, rp, rp2, fh;
  44. FROM MPDat    IMPORT    OpenConfig, CloseConfig, GetConfigParams,
  45.             SetConfigParams;
  46.  
  47. VAR     Datei                : File;
  48.         PrgPath, FileName,
  49.         CompExt, LinkExt,
  50.         CompilHlp, LinkerHlp        : BufStrTyp;
  51.        ConTit                : ARRAY [0..79] OF CHAR;
  52.        WinLeftMax, WinTopMax,
  53.         WinLeftMin, WinTopMin,
  54.         ConLeft, ConTop,
  55.         ConWidth, ConHeight,
  56.         gadPos                : INTEGER;
  57.     maketog                : BOOLEAN;
  58.  
  59.  
  60.  
  61. (* Liest s:Compi.config aus, wenn besteht, sonst wird neu eingerichtet *)
  62. PROCEDURE LoadConfig;
  63. BEGIN
  64.  IF NOT maketog THEN
  65.     OpenConfig (Datei, "s:Compi.config", FALSE)
  66.  ELSIF maketog THEN
  67.      OpenConfig (Datei, "s:Compi2.config", FALSE)
  68.  END;
  69.          GetConfigParams (Datei, CompilBuf);
  70.          GetConfigParams (Datei, LinkerBuf);
  71.         GetConfigParams (Datei, LoaderBuf);
  72.          GetConfigParams (Datei, EditBuf);
  73.      CloseConfig (Datei);
  74.      RefreshGadgets (ADR(LoadGad), win2, NIL)
  75. END LoadConfig;
  76.  
  77. (* Speichert Angaben des Eingabefensters in s:Compi.config *)
  78. PROCEDURE SaveConfig;
  79. BEGIN
  80.  IF NOT maketog THEN
  81.     OpenConfig (Datei, "s:Compi.config", TRUE)
  82.  ELSIF maketog THEN
  83.      OpenConfig (Datei, "s:Compi2.config", TRUE)
  84.  END;
  85.          SetConfigParams (Datei, CompilBuf);
  86.          SetConfigParams (Datei, LinkerBuf);
  87.          SetConfigParams (Datei, LoaderBuf);
  88.          SetConfigParams (Datei, EditBuf);
  89.     CloseConfig (Datei);
  90. END SaveConfig;
  91.  
  92. (* Ermittelt letztes Vorkommen von token(=CHAR) in Str *)
  93. PROCEDURE LastPos (Str : ARRAY OF CHAR; token : CHAR; start : INTEGER) : INTEGER;
  94. VAR i, len : INTEGER;
  95. BEGIN
  96.  len := Length (Str);
  97.  FOR i:=len TO start BY -1 DO
  98.   IF (Str[i] = token) THEN
  99.    RETURN i
  100.   END
  101.  END;
  102.  RETURN -1
  103. END LastPos;
  104.  
  105. (* Holt Laufwerksbezeichnung und Dateiname aus Eingabestring *)
  106. PROCEDURE Extract (File : ARRAY OF CHAR; VAR dir, prefix : ARRAY OF CHAR);
  107. VAR dirpos, prepos, subpos, len    : INTEGER;
  108.     ok                : BOOLEAN;
  109. BEGIN
  110.  len    := Length (File);
  111.  dirpos := Occurs (File, first, ":", FALSE);
  112.  subpos := LastPos (File, "/", first);
  113.  prepos := Occurs (File, first, ".", FALSE);
  114.  
  115.  IF (subpos # last) THEN
  116.   Copy (dir, File, first, subpos+1);
  117.   ok := CD (dir);
  118.   IF (prepos # last) THEN   Copy (prefix, File, subpos+1, prepos-subpos-1)
  119.   ELSE   Copy (prefix, File, subpos+1, len-subpos-1)  END
  120.  ELSIF (subpos = last) THEN
  121.   IF (dirpos # last) THEN
  122.    Copy (dir, File, first, dirpos+1);
  123.    ok := CD (dir);
  124.    IF (prepos # last) THEN  Copy (prefix, File, dirpos+1, prepos-dirpos-1)
  125.    ELSE Copy (prefix, File, dirpos+1, len-dirpos-1)  END
  126.   ELSIF (dirpos = last) THEN
  127.    IF (prepos # last) THEN  Copy (prefix, File, first, prepos)
  128.    ELSE Copy (prefix, File, first, len)  END
  129.   END
  130.  END;
  131. END Extract;
  132.  
  133. PROCEDURE GetExt (VAR Prog, Ext : ARRAY OF CHAR);
  134. VAR len, extpos : INTEGER;
  135. BEGIN
  136.  len := Length (Prog);        extpos := LastPos (Prog, ".", first);
  137.  IF (extpos # last) THEN
  138.   Copy (Ext, Prog, extpos, len-extpos);
  139.   Delete (Prog, extpos, len-extpos)
  140.  END
  141. END GetExt;
  142.  
  143. PROCEDURE ExistFile (Prog : ARRAY OF CHAR) : BOOLEAN;
  144. VAR L : FileLockPtr;
  145. BEGIN
  146.  L := NIL;
  147.  L := Lock (ADR(Prog), sharedLock);
  148.  IF L # NIL THEN
  149.   UnLock (L);
  150.   RETURN TRUE
  151.  ELSE
  152.   SetPenColor (fh, 37);
  153.   WriteS (fh, "File not available !");
  154.   SetPenColor (fh, 0);
  155.   WriteLn (fh);
  156.   RETURN FALSE
  157.  END
  158. END ExistFile;
  159.  
  160. (* Führt übergebenen String als CLI-Kommando aus *)
  161. PROCEDURE Exec (Prog : ARRAY OF CHAR);
  162. VAR done : INTEGER;
  163.     Help : BufStrTyp;
  164. BEGIN
  165.  Str.Copy (Help, Prog);        Str.Concat (Help, " launched ...");
  166.  WriteLn (fh);
  167.  SetPenColor (fh, 37);
  168.  WriteS (fh, Help);
  169.  SetPenColor (fh, 0);        WriteLn (fh);    WriteLn (fh);
  170.  done := Execute (ADR(Prog), NIL, fh)
  171. END Exec;
  172.  
  173. (* Setzt Filenamen in Compileraufruf anstelle des Platzhalters ein *)
  174. PROCEDURE Prepare (Envir, Prog, Ext : ARRAY OF CHAR; new,loader,tog : BOOLEAN);
  175. VAR pos    : INTEGER;
  176.     ok    : BOOLEAN;
  177.     Strn: BufStrTyp;
  178. BEGIN
  179.  ok := FALSE;
  180.  IDCMPOff (win);
  181.  IF (Prog[0]=0C) THEN Prog[0]:=" "; Prog[1]:=0C END;
  182.  IF NOT tog THEN
  183.   IF loader THEN
  184.    Str.Copy (Strn, Prog);
  185.    Str.Concat (Strn, Ext);
  186.    ok := ExistFile (Strn)
  187.   ELSE
  188.    Str.Concat (Prog, Ext);
  189.    ok := ExistFile (Prog)
  190.   END;
  191.  ELSE
  192.   ok := ExistFile (Prog)
  193.  END;
  194.  IF ok OR new THEN
  195.   pos := Occurs (Envir, first, "#", FALSE);
  196.   Delete (Envir, pos, 1);
  197.   Insert (Envir, pos, Prog);
  198.   Exec (Envir)
  199.  END;
  200.  IDCMPOn (win, IDCMPFlagSet{closeWindow, gadgetUp, menuPick})
  201. END Prepare;
  202.  
  203. (* Compilieren, Linken und ausführen *)
  204. PROCEDURE RunAll (Comp, Link, Name : ARRAY OF CHAR);
  205. VAR ok : BOOLEAN;
  206. BEGIN
  207.  ok := FALSE;
  208.  Prepare (Comp, Name, CompExt, FALSE, FALSE, maketog);
  209.  Prepare (Link, Name, LinkExt, FALSE, FALSE, maketog);
  210.  IF (Name[0]#0C) THEN
  211.   ok := ExistFile (Name);
  212.   IF ok THEN Exec (Name) END
  213.  END
  214. END RunAll;
  215.  
  216. (* Setzt Titel des Ausgabefensters *)
  217. PROCEDURE SetConTitle (Merge : ARRAY OF CHAR);
  218. VAR pos : INTEGER;
  219. BEGIN
  220.  ConTit := " MPCompile V3.3 --- Output  :               ";
  221.  pos := Occurs (ConTit, first, ":", FALSE);
  222.  Insert (ConTit, pos+2, Merge);
  223.  Insert (ConTit, Length (ConTit), "                                             ");
  224.  SetWindowTitles (ConPtr, ADR(ConTit), NIL)
  225. END SetConTitle;
  226.  
  227. (* Öffnet Eingabefenster *)
  228. PROCEDURE OpenPop;
  229. VAR ok        : BOOLEAN;
  230. BEGIN
  231.   win2 := CreateWindow (WinLEFT, WinTOP+WinHEIGHT+1, WinWIDTH, 115,
  232.            IDCMPFlagSet{closeWindow, gadgetUp, activeWindow},
  233.               WindowFlagSet{windowDrag, windowDepth, windowClose, windowActive,
  234.               gimmeZeroZero, activate}, ADR(MakeGad), NIL,
  235.               ADR("        MPCompile --- PopWindow Preferences         "),
  236.               ScreenFlagSet{wbenchScreen});
  237.  Assert(win2#NIL,ADR("Kann Fenster nicht öffnen"));
  238.  rp2:=win2^.rPort;
  239.  DrawText (rp2);
  240.  IF (CompilBuf[0] = 0C) THEN
  241.   LoadConfig;
  242.   CompilHlp := CompilBuf;    LinkerHlp := LinkerBuf;
  243.   GetExt (CompilHlp, CompExt);
  244.   GetExt (LinkerHlp, LinkExt);
  245.  END;
  246.  ok := ActivateGadget (ADR(PrgGad), win2, NIL)
  247. END OpenPop;
  248.  
  249. (* Fragt Gadgets des Einganfensters ab *)
  250. PROCEDURE GetPopWindow;
  251. VAR Msg2    : IntuiMessagePtr;
  252.     class2    : IDCMPFlagSet;
  253.     adr2    : GadgetPtr;
  254.     len        : INTEGER;
  255.     ok        : BOOLEAN;
  256. BEGIN
  257.  OpenPop;
  258.  LOOP
  259.   WaitPort (win2^.userPort);
  260.   Msg2 := GetMsg (win2^.userPort);
  261.   WHILE Msg2#NIL DO
  262.    class2 := Msg2^.class; adr2 := Msg2^.iAddress;
  263.    ReplyMsg (Msg2);
  264.    IF (closeWindow IN class2) THEN EXIT END;
  265.    IF (gadgetUp IN class2) THEN
  266.     CASE adr2^.gadgetID OF
  267.      loadgad    : LoadConfig;
  268.                CompilHlp := CompilBuf;
  269.                LinkerHlp := LinkerBuf;
  270.                GetExt (CompilHlp, CompExt);
  271.           GetExt (LinkerHlp, LinkExt)        |
  272.      savegad    : SaveConfig                |
  273.      compilgad    : CompilHlp := CompilBuf;
  274.                GetExt (CompilHlp, CompExt)        |
  275.      linkergad    : LinkerHlp := LinkerBuf;
  276.                GetExt (LinkerHlp, LinkExt)        |
  277.      prggad    : PrgPath[0]  := 0C; FileName[0] := 0C;
  278.                Extract (PrgBuf, PrgPath, FileName)     |
  279.      makegad    : maketog := NOT maketog        |
  280.     ELSE
  281.     END (* case *)
  282.    END; (* if *)
  283.    Msg2 := GetMsg (win2^.userPort)
  284.   END (* while *)
  285.  END; (* loop *)
  286.  IF win2#NIL THEN CloseWindow (win2); win2:=NIL END;
  287.  SetConTitle (PrgBuf)
  288. END GetPopWindow;
  289.  
  290. (* Verkleinert das Steuerfenster *)
  291. PROCEDURE MinWin;
  292. VAR dXMov, dYMov : INTEGER;
  293. BEGIN
  294.  ConLeft := ConPtr^.leftEdge; ConTop := ConPtr^.topEdge;
  295.  ConWidth := ConPtr^.width;   ConHeight := ConPtr^.height;
  296.  IF fh#NIL THEN   CloseCon (fh); fh := NIL   END;
  297.  gadPos := RemoveGList (win, ADR(CompGad), -1);
  298.  SetRast (rp, 0);
  299.  SizeWindow (win, -DWidth, -DHeight);
  300.  WinLeftMax := win^.leftEdge; WinTopMax := win^.topEdge;
  301.  dXMov := WinLeftMin - WinLeftMax;  dYMov := WinTopMin - WinTopMax;
  302.  MoveWindow (win, dXMov, dYMov);
  303.  SetWindowTitles (win, ADR("MPCompile"), NIL);
  304.  WindowToBack (win)
  305. END MinWin;
  306.  
  307. (* Vergrößert das Steuerfenster und CONSOLE-Fenster *)
  308. PROCEDURE MaxWin;
  309. VAR dXMovW, dYMovW, dXMovC, dYMovC,
  310.     conwidth, conheight, realPos     : INTEGER;
  311. BEGIN
  312.  fh := OpenCon ("CON:50/53/500/80/ MPCompile V3.3  ---  Output   :                        ");
  313.  ConPtr := ActivWindow ();
  314.  WindowToFront (ConPtr);
  315.  WinLeftMin := win^.leftEdge; WinTopMin := win^.topEdge;
  316.  dXMovW := WinLeftMax - WinLeftMin; dYMovW := WinTopMax - WinTopMin;
  317.  dXMovC := ConLeft - ConPtr^.leftEdge; dYMovC := ConTop - ConPtr^.topEdge;
  318.  conwidth := ConPtr^.width; conheight := ConPtr^.height;
  319.  IF (conwidth <= ConWidth) OR (conheight <= ConHeight) THEN
  320.   MoveWindow (ConPtr, dXMovC, dYMovC);
  321.   SizeWindow (ConPtr, ConWidth - conwidth, ConHeight - conheight)
  322.  ELSIF (conwidth > ConWidth) OR (conheight > ConHeight) THEN
  323.   SizeWindow (ConPtr, ConWidth - conwidth, ConHeight - conheight);
  324.   MoveWindow (ConPtr, dXMovC, dYMovC)
  325.  END;
  326.  MoveWindow (win, dXMovW, dYMovW);
  327.  SizeWindow (win, DWidth, DHeight);
  328.  SetConTitle (PrgBuf);
  329.  SetWindowTitles (win, ADR(winTitle), NIL);
  330.  WindowToFront (win);
  331.  realPos := AddGList (win, ADR(CompGad), gadPos, -1, NIL);
  332.  RefreshGadgets (ADR(CompGad), win, NIL)
  333. END MaxWin;
  334.  
  335. (* Holt Messages des Steuerfensters *)
  336. PROCEDURE GetIntuiMsg;
  337. VAR Msg        : IntuiMessagePtr;
  338.     class    : IDCMPFlagSet;
  339.     adr        : GadgetPtr;
  340.     toggle, ok    : BOOLEAN;
  341. BEGIN
  342.  toggle:=FALSE;    ok := FALSE;
  343.  LOOP
  344.   WaitPort (win^.userPort);
  345.   Msg := GetMsg (win^.userPort);
  346.   WHILE Msg#NIL DO
  347.    class := Msg^.class; adr := Msg^.iAddress;
  348.    ReplyMsg (Msg);
  349.    IF (closeWindow IN class) THEN EXIT END;
  350.    IF (menuPick IN class) THEN
  351.     toggle:=NOT toggle;
  352.     IF toggle THEN  MinWin  ELSE  MaxWin  END
  353.    END;
  354.    IF (gadgetUp IN class) THEN
  355.     CASE adr^.gadgetID OF
  356.      compgad     : Prepare (CompilHlp, FileName, CompExt,FALSE,FALSE,maketog) |
  357.      linkgad    : Prepare (LinkerHlp, FileName, LinkExt,FALSE,FALSE,maketog) |
  358.      debuggad    : Prepare (LoaderBuf, FileName, LinkExt,FALSE,TRUE, maketog) |
  359.      rungad    : RunAll (CompilHlp, LinkerHlp, FileName)             |
  360.      exgad    : IF (FileName[0]#0C) THEN
  361.                 ok := ExistFile (FileName);
  362.                 IF ok THEN Exec (FileName) END
  363.                END                                 |
  364.      edgad    : Prepare (EditBuf, FileName, CompExt, TRUE, FALSE, maketog) |
  365.      popgad    : GetPopWindow                             |
  366.     ELSE
  367.     END (* case *)
  368.    END; (* if *)
  369.    Msg := GetMsg (win^.userPort)
  370.   END (* while *)
  371.  END (* loop *)
  372. END GetIntuiMsg;
  373.  
  374.  
  375. BEGIN
  376.  WinLeftMin := 420;    WinTopMin := 15;
  377.  CompExt[0] := 0C;    LinkExt[0]:= 0C;    maketog := FALSE;
  378.  
  379.  GetPopWindow;
  380.  
  381.  GetIntuiMsg;
  382.  
  383. END MPCompile.Mod
  384.